perm filename ALC.SAI[OLD,HE] blob sn#466124 filedate 1979-08-14 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "alc"  COMMENT   Source files
C00004 00003	EXTERNAL INTEGER RPGSW	! Tells if run by other program (parser or snail)
C00010 ENDMK
C⊗;
BEGIN "alc"  COMMENT   Source files;

REQUIRE "ABBREV.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "MACROS.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "RECAUX.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "PRINTX.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "SNAILR.SAI[AL,HE]" SOURCE_FILE;

REQUIRE 1000 SYSTEM!PDL;

REQUIRE "ALREC.REL[AL,HE]" LOAD_MODULE;

REQUIRE "WLDMOD.REL[AL,HE]" LOAD_MODULE;
    EXTERNAL RANY PROCEDURE STINTERP(RANY S,WLD);

EXTERNAL RECURSIVE PROCEDURE ALPRIN(RANY S);

REQUIRE "GOBBLE.HDR[AL,HE]" SOURCE_FILE;

REQUIRE "PASS3.REL[AL,HE]" LOAD_MODULE;
    EXTERNAL RECURSIVE PROCEDURE TSCAN (RANY PARSETREE);
    EXTERNAL PROCEDURE INITOUT(STRING FNAME,PPN; BOOLEAN SF(TRUE));
    EXTERNAL PROCEDURE CLOSEOUT;

PROCEDURE GCKILL;
    BEGIN
    REQUIRE "SYS:GOGTAB.DEF" SOURCE_FILE;
    EXTERNAL INTEGER ARRAY GOGTAB[0:1000];
    GOGTAB[RGCOFF] ← TRUE		! Turn off garbage collection;
    END;

STRING PROCEDURE GETPPN;
    BEGIN
    STRING P,PN;
    P ← CVXSTR(CALL(0,"DSKPPN"))[1 FOR 3];
    PN ← CVXSTR(CALL(0,"DSKPPN"))[4 FOR 3];
    WHILE P = " " DO P ← P[2 FOR ∞];
    WHILE PN = " " DO PN ← PN[2 FOR ∞];
    RETURN("["&P&","&PN&"]")
    END;
EXTERNAL INTEGER RPGSW;	! Tells if run by other program (parser or snail);
PRELOAD_WITH CVSIX("SYS"),CVSIX("PALX"),CVSIX("DMP"),0,0,0;
SAFE INTEGER ARRAY RUN[1:6];
RCELL SE; ! For the result of READ;
RANY BS; ! For the result of GROVEL;

GCKILL;

IF RPGSW THEN
    BEGIN  "rpg mode"
    BOOLEAN BRK,SAVE_SEXPR,SYM_FILE,NEW_VERSION;
    INTEGER CHN;
    STRING COMMAND,PALX_LST,COMP1;
    RPTR(FILE) SEX_FILE,OUT_FILE,LST_FILE;
    RPTR(FILE_SWITCH) SWITCH;

    OUT_FILE ← NEW_RECORD(FILE);
    LST_FILE ← NEW_RECORD(FILE);

    COMMAND ← TMPIN("ALC",BRK);
    IF BRK THEN USERERR(0,0,"TMPIN lost") ELSE PRINT("ALC"&CRLF);
    SEX_FILE ← SCAN_COMMAND(COMMAND,OUT_FILE,LST_FILE);
    SWITCH ← FILE:SWITCHES[SEX_FILE];
    WHILE SWITCH ≠ RNULL DO
	BEGIN
	IF EQU("L",FILE_SWITCH:NAME[SWITCH]) ∧ FILE_SWITCH:OCTAL[SWITCH]=0 THEN
	    PALX_LST ← ","&FILE:NAME[OUT_FILE]&".LST"
	ELSE IF EQU("S",FILE_SWITCH:NAME[SWITCH]) ∧ FILE_SWITCH:OCTAL[SWITCH]=0 THEN
	    SYM_FILE ← TRUE
	ELSE IF EQU("I",FILE_SWITCH:NAME[SWITCH]) ∧ FILE_SWITCH:OCTAL[SWITCH]=0 THEN
	    SAVE_SEXPR ← TRUE
	ELSE IF EQU("X",FILE_SWITCH:NAME[SWITCH]) ∧ FILE_SWITCH:OCTAL[SWITCH]=0 THEN
	    NEW_VERSION ← TRUE;
	SWITCH ← FILE_SWITCH:NEXT[SWITCH]
	END;

    SE ← FREAD(FILE:NAME[SEX_FILE]&"."&FILE:EXT[SEX_FILE]&FILE:PPN[SEX_FILE]);
    BS ← GROVEL(SE);

    IF ¬SAVE_SEXPR THEN		! delete ".sex" file;
	BEGIN
	CHN ← GETCHAN;
	OPEN(CHN,"DSK",0,0,0,512,BRK,BRK);
	LOOKUP(CHN,FILE:NAME[SEX_FILE]&"."&FILE:EXT[SEX_FILE]&FILE:PPN[SEX_FILE],BRK);
	RENAME(CHN,NULL,0,BRK);
	RELEASE(CHN)
	END;

    $RECGC;		! Garbage collect;
    IF ¬FILE:EOF[LST_FILE] THEN
	BEGIN
	IF FILE:EXT[LST_FILE]=NULL THEN FILE:EXT[LST_FILE] ← "ALL";
	SETPRINT(FILE:NAME[LST_FILE]&"."&FILE:EXT[LST_FILE]&FILE:PPN[LST_FILE],"F");
	ALPRIN(BS);
	SETPRINT(NULL,"T")
	END;

    STINTERP(BS,RNULL);	! simulation phase;

    IF ¬FILE:EOF[OUT_FILE] THEN
	BEGIN
	$RECGC;		! Garbage collect;
	INITOUT(FILE:NAME[OUT_FILE],FILE:PPN[OUT_FILE],SYM_FILE);
	TSCAN(BS);	! code emission phase;
	CLOSEOUT;
	IF FILE:EXT[OUT_FILE] = NULL THEN FILE:EXT[OUT_FILE] ← "BIN";
	IF FILE:PPN[OUT_FILE] = NULL THEN FILE:PPN[OUT_FILE] ← GETPPN;
	IF PALX_LST ≠ NULL THEN PALX_LST ← PALX_LST&FILE:PPN[OUT_FILE];
	COMP1 ← IF NEW_VERSION THEN "←COMP1.NEW[AL,HE]," ELSE "←COMP1.PAL[AL,HE],";
	TMPOUT("PAL",FILE:NAME[OUT_FILE]&"."&FILE:EXT[OUT_FILE]&FILE:PPN[OUT_FILE]
	    &PALX_LST & COMP1 & FILE:NAME[OUT_FILE]&".ALP" & FILE:PPN[OUT_FILE]&","
	    &FILE:NAME[OUT_FILE]&".ALT,"&FILE:NAME[OUT_FILE]&".ALV,"
	    &"COMP2.PAL[AL,HE]"&'15&'12&"ALSOAP.DMP[AL,HE]!",BRK);
	IF BRK THEN USERERR(0,1,"TMPOUT lost");
	CALL('1000000+LOCATION(RUN[1]),"RUN")
	END
    END

ELSE BEGIN
    INTEGER T1,T2,T3,T4;
    STRING PPN;
    SETPRINT(NULL,"T");
    PRINT("OUTPUT PPN ( [foo . bar] ) = ");
    PPN ← INCHWL;

    WHILE TRUE DO
	BEGIN  "trial"
	STRING COMP;
	PRINT("OUTPUT FILE: ");
	COMP ← INCHWL;
	IF COMP = NULL THEN COMP ← "COMP";
	T1 ← CALL(0,"RUNTIM");
	SE ← READ;
	BS ← GROVEL(SE);
	ALPRIN(BS);
	$RECGC;
	T2 ← CALL(0,"RUNTIM");
	PRINT(CRLF);
	PRINT(CRLF&"BEGINNING SIMULATION PHASE"&CRLF);
	STINTERP(BS,RNULL);
	$RECGC;
	T3 ← CALL(0,"RUNTIM");
	INITOUT(COMP,PPN);
	PRINT(CRLF&"BEGINNING CODE EMISSION PHASE"&CRLF);
	TSCAN(BS);
	T4 ← CALL(0,"RUNTIM");
	PRINT(CRLF&"    ",T4-T1," msec  ( ",T2-T1,":",T3-T2,":",T4-T3," )"&crlf)
	END "trial";
    END;

END "alc";